Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
2 Feb 95
Syntax10b.Scn.Fnt
MODULE DialogFrames;
	(** extended version Markus Knasm
ller 25.May.94 -  
	IMPORT
		Dialogs, Display, Files, Input, MenuViewers, Oberon, TextFrames, Texts, Viewers;
	CONST
		bkCol = 13;
		menu = "System.Close  System.Copy  System.Grow";
		gridMax* = 100; gridMin* = 1;
	TYPE
		Frame* = POINTER TO FrameDesc;
		FrameDesc* = RECORD(Display.FrameDesc)
			col*: INTEGER;  (** background-color of the frame *)
			panel*: Dialogs.Panel;  (** panel displayed in this frame *)
			grid*: INTEGER; (** grid of the frame *)
			pat*: Display.Pattern; (** background-pattern *)
		END;
		GetFrameMsg* = RECORD(Display.FrameMsg)
			p*: Dialogs.Panel;
			f*: Frame;
		END;
		SetCaretMsg = RECORD(Display.FrameMsg)
			p: Dialogs.Panel;  
			x, y: INTEGER;
		END; 
		w0: Texts.Writer;
		left, right, top, bot: INTEGER;
	PROCEDURE Min (x, y: INTEGER): INTEGER;
	BEGIN IF x < y THEN RETURN x ELSE RETURN y END
	END Min;
	PROCEDURE (f: Frame) MarkMenu; 
	(* see TextFrames *)
		VAR r: Texts.Reader; v: Viewers.Viewer; t: Texts.Text; ch: CHAR; 
	BEGIN 
		v := Viewers.This (f.X, f.Y);
		IF (v IS MenuViewers.Viewer) & (v.dsc IS TextFrames.Frame) & (f # v.dsc) THEN
			t := v.dsc(TextFrames.Frame).text;
			IF t.len > 0 THEN Texts.OpenReader(r, t, t.len - 1); Texts.Read(r, ch) ELSE ch := 0X END;
			IF ch # "!" THEN Texts.Write(w0, "!"); Texts.Append(t, w0.buf) END
		END;
	END MarkMenu;
	PROCEDURE (f: Frame) Restore*;
	(** restores the frame *)
	BEGIN
		Oberon.RemoveMarks (f.X, f.Y, f.W, f.H); 
		IF f.pat # MAX (INTEGER) THEN
			Display.ReplPatternC (f, f.col, f.pat, f.X, f.Y, f.W, f.H, f.X, f.Y, Display.replace)
		ELSE
			Display.ReplConstC (f, f.col, f.X, f.Y, f.W, f.H, Display.replace)
		END;
		f.panel.Draw (f.X, f.Y + f.H, f)
	END Restore;
	PROCEDURE (f: Frame) DrawObject (o: Dialogs.Object; drawmode: BOOLEAN);
	(* drawmode = TRUE => Draw	 drawmode = FALSE => Delete *)
		VAR x, y, ox, oy, ow, oh: INTEGER; i: LONGINT;
	BEGIN 
		o.GetDim (ox, oy, ow, oh); x := f.X + ox; y := f.Y + f.H + oy; 
		Oberon.RemoveMarks (x, y, ow, oh); 
		IF (~ drawmode) THEN  
			Display.ReplConstC (f, f.col, x, y, ow, oh, Display.paint); 
			IF f.pat # MAX (INTEGER) THEN Display.ReplPatternC (f, f.col, f.pat, x, y, ow, oh, f.X, f.Y, Display.replace) END
		ELSE
			o.Draw (x, y, f) 
		END
	END DrawObject;
	PROCEDURE (f: Frame) TrackMouse (x, y: INTEGER; keys: SET);
	BEGIN 
		Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
		WHILE keys # {} DO
			Input.Mouse (keys, x, y);
			Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
		END 
	END TrackMouse;
	PROCEDURE (f: Frame) Send (x, y: INTEGER; VAR m: Display.FrameMsg; VAR cond: BOOLEAN);
		VAR o: Dialogs.Object;
	BEGIN
		o := f.panel.ThisObject (x - f.X, y - f.Y - f.H);
		IF o # NIL THEN o.Handle (f, m); cond := TRUE ELSE cond := FALSE END 
	END Send;
	PROCEDURE (f: Frame) Extend (newY: INTEGER);
		VAR dY, newH: INTEGER;
	BEGIN 
		dY := f.Y - newY;
		IF f.pat # MAX (INTEGER) THEN
			Display.ReplPattern (f.col, f.pat, f.X, newY, f.W, f.Y - newY, Display.replace)
		ELSE
			Display.ReplConst (f.col, f.X, newY, f.W, f.Y - newY, Display.replace)
		END;
		f.H := f.H + f.Y - newY; f.Y := newY;
		f.panel.Draw (f.X, f.Y + f.H, f)
	END Extend;
	PROCEDURE (f: Frame) Reduce (newY: INTEGER);
	BEGIN f.H := f.H + f.Y - newY; f.Y := newY
	END Reduce;
	PROCEDURE (f: Frame) Modify (id, dY, y, h: INTEGER);
	BEGIN
		Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
		f.panel.RemoveSelections;
		IF id = MenuViewers.extend THEN
			IF dY > 0 THEN
				IF f.pat # MAX (INTEGER) THEN
					Display.ReplPattern (f.col, f.pat, f.X, f.Y + dY, f.W, f.H, Display.replace)
				ELSE
					Display.ReplConst (f.col, f.X, f.Y + dY, f.W, f.H, Display.replace)
				END;
				INC (f.Y, dY)
			END;
			f.Extend (y)
		ELSIF id = MenuViewers.reduce THEN
			f.Reduce (y + dY);
			IF dY > 0 THEN Display.CopyBlock(f.X, f.Y, f.W, f.H, f.X, y, Display.replace); f.Y := y END
		END
	END Modify;
	PROCEDURE Handle* (f: Display.Frame; VAR m: Display.FrameMsg);
	(** handles the message m sent to frame f *)
	VAR cond: BOOLEAN; copy: Frame;
		PROCEDURE IsIn (f: Display.Frame; x, y: INTEGER): BOOLEAN;
		BEGIN
			IF (x >= f.X) & (x <= f.X + f.W) & (y > f.Y) & (y <= f.Y + f.H) THEN RETURN TRUE ELSE RETURN FALSE END
		END IsIn;
	BEGIN
		WITH f: Frame DO
			WITH m: Oberon.InputMsg DO 
				IF m.id = Oberon.track THEN 
					IF IsIn (f, m.X, m.Y) THEN
						f.Send (m.X, m.Y, m, cond); (* sends it to object *)
						IF ~ cond THEN f.TrackMouse (m.X, m.Y, m.keys) (* draws cursor if there is no object *) END
					END
				ELSE f.panel.Broadcast (f, m)
				END
			| m: MenuViewers.ModifyMsg DO f.Modify (m.id, m.dY, m.Y, m.H); f.panel.Broadcast (f, m)
			| m: Oberon.CopyMsg DO NEW (copy); copy^ := f^; m.F := copy; 
			| m: Dialogs.NotifyMsg DO
				IF m.id = 0 THEN IF f.panel.Contains (m.obj) THEN f.DrawObject (m.obj, TRUE) END
				ELSIF m.id = 1 THEN IF f.panel.Contains (m.obj) THEN f.DrawObject (m.obj, FALSE) END
				ELSIF m.id = 2 THEN IF m.p = f.panel THEN  f.MarkMenu END
				ELSIF m.id = 3 THEN IF m.p = f.panel THEN f.Restore END
				END
			| m: SetCaretMsg DO
				IF m.p = f.panel THEN
					Oberon.RemoveMarks (f.X, f.Y, f.W, f.H); Oberon.Pointer.X := m.x + f.X; Oberon.Pointer.Y := m.y + f.Y + f.H;
				END
			| m: GetFrameMsg DO
				IF f.panel = m.p THEN m.f := f END
			ELSE
				f.panel.Broadcast (f, m)  (* sends it to all objects in the panel *)
			END
		END
	END Handle;
	PROCEDURE (f: Frame) Open* (handle: Display.Handler; p: Dialogs.Panel);
	(** opens the frame f with the handler handle and the panel p *)
	BEGIN f.handle := handle; f.panel := p; f.col := bkCol; f.grid := 1; f.pat := MAX (INTEGER) 
	END Open;
	PROCEDURE GetCaretPosition* (VAR p: Dialogs.Panel; VAR xpos, ypos: INTEGER);
	(** returns the panel p and the positin (xpos, ypos) of the caret *)
		VAR x, y: INTEGER; f: Frame; v: Viewers.Viewer;
	BEGIN
		x := Oberon.Pointer.X; y := Oberon.Pointer.Y;  
		v := Viewers.This (x, y);
		IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS Frame) THEN 
			f := v.dsc.next(Frame); p := f.panel; xpos := x - f.X; ypos := y - f.Y - f.H
		ELSE p := NIL
		END
	 END GetCaretPosition;
	PROCEDURE box (obj: Dialogs.Object; VAR done: BOOLEAN);
		VAR x, y, w, h: INTEGER;
	BEGIN
		obj.GetDim (x, y, w, h);
		IF x < left THEN left := x END;
		IF y < bot THEN bot := y END;
		IF x + w > right THEN right := x + w END;
		IF y + h > top THEN top := y + h END
	END box;
	PROCEDURE OpenPanel* (name: ARRAY OF CHAR; x, y: INTEGER; VAR p: Dialogs.Panel);
	(** reads a panel p from file name and opens a viewer at x, y showing that panel *)
		VAR f: Frame; file: Files.File; r: Files.Rider; h, res: INTEGER; v, vmax: Viewers.Viewer; m: TextFrames.Frame;
			t: Texts.Text; buf: Texts.Buffer; 
	BEGIN
		file := Files.Old (name); NEW (p); 
		IF file # NIL THEN Files.Set (r, file, 0); p.Load (r) END;
		NEW (f); f.Open (Handle, p); 
		v := Viewers.This (x, 0);  vmax := NIL; h := 0;
		WHILE v.state > 1  DO 
			IF v.H > h THEN vmax := v; h := v.H END;
			v := Viewers.Next (v)
		END;
		IF vmax # NIL THEN
			left := MAX (INTEGER); right := MIN (INTEGER); bot := MAX (INTEGER); top := MIN (INTEGER);
			p.Enumerate (box);
			y := Min (vmax.Y + ABS (bot) + 10 + TextFrames.menuH, vmax.Y + vmax.H - TextFrames.menuH - 2) 
		END; 
		IF Files.Old ("Dialog.Menu.Text") = NIL THEN 
			m := TextFrames.NewMenu (name, menu)
		ELSE 
			m := TextFrames.NewMenu (name, "");
			NEW (t); Texts.Open (t, "Dialog.Menu.Text");
			NEW (buf); Texts.OpenBuf (buf); Texts.Save (t, 0, t.len, buf); Texts.Append (m.text, buf)
		END;
		v := MenuViewers.New (m, f, TextFrames.menuH, x, y);
		IF p.cmd[0] # 0X THEN 
			Dialogs.cmdPanel := p; 
			Oberon.Call (p.cmd, Oberon.Par, FALSE, res)
		END;
	END OpenPanel;
	PROCEDURE FindObject* (VAR o: Dialogs.Object; VAR p: Dialogs.Panel);
	(** returns the object o below the caret and the panel p containing it *)
		VAR x, y: INTEGER;
	BEGIN
		GetCaretPosition (p, x, y); 
		IF p # NIL THEN 
			o := p.ThisObject (x, y); 
			IF o # NIL THEN Dialogs.res := Dialogs.ok ELSE Dialogs.res := Dialogs.objectNotFound END
		ELSE Dialogs.res := Dialogs.noPanelSelected
		END
	END FindObject;			
	PROCEDURE SetCaretAtObject* (o: Dialogs.Object);
	(** sets the caret in a way that the object o is below the caret *)
		VAR msg: SetCaretMsg; x, y, w, h: INTEGER;
	BEGIN
		o.GetDim (x, y, w, h);
		msg.p := o.panel; msg.x := x; msg.y := y;
		Viewers.Broadcast (msg)
	END SetCaretAtObject; 
BEGIN Texts.OpenWriter (w0)
END DialogFrames.